home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Src Code / ERRORBAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  12.0 KB  |  401 lines
  1. {**********************************************}
  2. {   TErrorBarSeries (derived from TBarSeries)  }
  3. {   Copyright (c) 1995-1998 by David Berneda   }
  4. {**********************************************}
  5. {$I teedefs.inc}
  6. unit ErrorBar;
  7.  
  8. interface
  9.  
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, TeEngine, Series,
  12.   TeCanvas;
  13.  
  14. type
  15.   TErrorSeriesStyle=( essLeft,essRight,essLeftRight,
  16.                       essTop,essBottom,essTopBottom);
  17.  
  18.   TErrorWidthUnits=(ewuPercent,ewuPixels);
  19.  
  20.   TCustomErrorSeries = class(TBarSeries)
  21.   private
  22.     { Private declarations }
  23.     FErrorPen        : TChartPen;
  24.     FErrorStyle      : TErrorSeriesStyle;
  25.     FErrorValues     : TChartValueList;
  26.     FErrorWidth      : Integer;
  27.     FErrorWidthUnits : TErrorWidthUnits;
  28.     { internal }
  29.     IDrawBar         : Boolean;
  30.     Function GetErrorValue(Index:Longint):Double;
  31.     Procedure PrepareErrorPen(ValueIndex:Integer);
  32.     Procedure SetErrorStyle(Value:TErrorSeriesStyle);
  33.     Procedure SetErrorValue(Index:Longint; Const Value:Double);
  34.     Procedure SetErrorValues(Value:TChartValueList);
  35.     Procedure SetErrorWidthUnits(Value:TErrorWidthUnits);
  36.     Procedure SetErrorPen(Value:TChartPen);
  37.     Procedure SetErrorWidth(Value:Integer);
  38.   protected
  39.     { Protected declarations }
  40.     Procedure DrawError(X,Y,AWidth,AHeight:Longint; Draw3D:Boolean);
  41.     Procedure SetSeriesColor(AColor:TColor); override;
  42.   public
  43.     { Public declarations }
  44.     Constructor Create(AOwner: TComponent); override;
  45.     Destructor Destroy; override;
  46.  
  47.     Function AddErrorBar(Const AX,AY,AError:Double;
  48.                          Const AXLabel:String{$IFDEF D4}=''{$ENDIF};
  49.                          AColor:TColor{$IFDEF D4}=clTeeColor{$ENDIF}):Longint;
  50.     Procedure CalcHorizMargins(Var LeftMargin,RightMargin:Integer); override;
  51.     Procedure CalcVerticalMargins(Var TopMargin,BottomMargin:Integer); override;
  52.     Procedure DrawBar(BarIndex,StartPos,EndPos:Longint); override;
  53.     Procedure DrawLegendShape(ValueIndex:Longint; Const Rect:TRect); override;
  54.     Procedure FillSampleValues(NumValues:Longint); override; { <-- to add random error values }
  55.     Function GetEditorClass:String; override;
  56.     Function MinYValue:Double; override;
  57.     Function MaxYValue:Double; override;
  58.     property ErrorValue[Index:Longint]:Double read GetErrorValue
  59.                                               write SetErrorValue;
  60.     Procedure Assign(Source:TPersistent); override;
  61.     Procedure PrepareForGallery(IsEnabled:Boolean); override;
  62.     { To be published declarations }
  63.     property ErrorPen:TChartPen read FErrorPen write SetErrorPen;
  64.     property ErrorStyle:TErrorSeriesStyle read FErrorStyle write SetErrorStyle
  65.                                           default essTopBottom;
  66.     property ErrorValues:TChartValueList read FErrorValues write SetErrorValues;
  67.     property ErrorWidth:Integer read FErrorWidth write SetErrorWidth default 100;
  68.     property ErrorWidthUnits:TErrorWidthUnits read FErrorWidthUnits
  69.                                               write SetErrorWidthUnits default ewuPercent;
  70.   end;
  71.  
  72.   TErrorSeries=class(TCustomErrorSeries)
  73.   published
  74.     property ErrorPen;
  75.     property ErrorStyle;
  76.     property ErrorValues;
  77.     property ErrorWidth;
  78.     property ErrorWidthUnits;
  79.   end;
  80.  
  81.   TErrorBarSeries=class(TCustomErrorSeries)
  82.   public
  83.     Constructor Create(AOwner:TComponent); override;
  84.     Procedure PrepareForGallery(IsEnabled:Boolean); override;
  85.   published
  86.     property ErrorPen;
  87.     property ErrorValues;
  88.     property ErrorWidth;
  89.     property ErrorWidthUnits;
  90.   end;
  91.  
  92. implementation
  93.  
  94. Uses Chart,TeeProCo,TeeConst;
  95.  
  96. Constructor TCustomErrorSeries.Create(AOwner: TComponent);
  97. Begin
  98.   inherited Create(AOwner);
  99.   IDrawBar:=False;
  100.   FErrorValues :=TChartValueList.Create(Self,TeeMsg_ValuesStdError); { <-- Std Error storage }
  101.   FErrorPen:=CreateChartPen;
  102.   FErrorStyle:=essTopBottom;
  103.   FErrorWidth:=100;
  104.   FErrorWidthUnits:=ewuPercent;
  105.   Marks.Visible:=False;
  106.   {$IFDEF TEETRIAL}
  107.   TeeTrial(ComponentState);
  108.   {$ENDIF}
  109. end;
  110.  
  111. Destructor TCustomErrorSeries.Destroy;
  112. begin
  113.   FErrorPen.Free;
  114.   inherited Destroy;
  115. end;
  116.  
  117. Procedure TCustomErrorSeries.CalcHorizMargins(Var LeftMargin,RightMargin:Integer);
  118. begin
  119.   inherited CalcHorizMargins(LeftMargin,RightMargin);
  120.   if (FErrorStyle=essLeft) or (FErrorStyle=essLeftRight) then
  121.      LeftMargin  :=MaxLong(LeftMargin, FErrorPen.Width);
  122.   if (FErrorStyle=essRight) or (FErrorStyle=essLeftRight) then
  123.      RightMargin :=MaxLong(RightMargin, FErrorPen.Width);
  124. end;
  125.  
  126. Procedure TCustomErrorSeries.CalcVerticalMargins(Var TopMargin,BottomMargin:Integer);
  127. begin
  128.   inherited CalcVerticalMargins(TopMargin,BottomMargin);
  129.   if (FErrorStyle=essTop) or (FErrorStyle=essTopBottom) then
  130.      TopMargin    :=MaxLong(TopMargin, FErrorPen.Width);
  131.   if (FErrorStyle=essBottom) or (FErrorStyle=essTopBottom) then
  132.      BottomMargin :=MaxLong(BottomMargin, FErrorPen.Width);
  133. end;
  134.  
  135. Procedure TCustomErrorSeries.SetErrorPen(Value:TChartPen);
  136. Begin
  137.   FErrorPen.Assign(Value);
  138.   if not IDrawBar then SeriesColor:=FErrorPen.Color;
  139. End;
  140.  
  141. Procedure TCustomErrorSeries.PrepareErrorPen(ValueIndex:Integer);
  142. begin
  143.   With ParentChart.Canvas do
  144.   begin
  145.     AssignVisiblePen(FErrorPen);
  146.     if (ValueIndex<>TeeAllValues) and (not IDrawBar) then
  147.        Pen.Color:=ValueColor[ValueIndex];
  148.     BackMode:=cbmTransparent;
  149.   end;
  150. end;
  151.  
  152. Procedure TCustomErrorSeries.SetErrorWidth(Value:Integer);
  153. Begin
  154.   SetIntegerProperty(FErrorWidth,Value);
  155. End;
  156.  
  157. Procedure TCustomErrorSeries.DrawError(X,Y,AWidth,AHeight:Longint; Draw3D:Boolean);
  158.  
  159.   Procedure DrawHoriz(XPos:Longint);
  160.   begin
  161.     With ParentChart.Canvas do
  162.     begin
  163.       if Draw3D then
  164.       begin
  165.         HorizLine3D(X,XPos,Y,MiddleZ);
  166.         VertLine3D(XPos,Y-AHeight,Y+AHeight,MiddleZ);
  167.       end
  168.       else
  169.       begin
  170.         DoHorizLine(X,XPos,Y);
  171.         DoVertLine(XPos,Y-AHeight,Y+AHeight);
  172.       end;
  173.     end;
  174.   end;
  175.  
  176.   Procedure DrawVert(YPos:Longint);
  177.   begin
  178.     With ParentChart.Canvas do
  179.     begin
  180.       if Draw3D then
  181.       begin
  182.         VertLine3D(X,Y,YPos,MiddleZ);
  183.         HorizLine3D(X-(AWidth div 2),X+(AWidth div 2),YPos,MiddleZ);
  184.       end
  185.       else
  186.       begin
  187.         DoVertLine(X,Y,YPos);
  188.         DoHorizLine(X-(AWidth div 2),X+(AWidth div 2),YPos);
  189.       end;
  190.     end;
  191.   end;
  192.  
  193. begin
  194.   Case FErrorStyle of
  195.     essLeft     : DrawHoriz(X-(AWidth div 2));
  196.     essRight    : DrawHoriz(X+(AWidth div 2));
  197.     essLeftRight: begin
  198.                     DrawHoriz(X-(AWidth div 2));
  199.                     DrawHoriz(X+(AWidth div 2));
  200.                   end;
  201.     essTop      : DrawVert(Y-AHeight);
  202.     essBottom   : DrawVert(Y+AHeight);
  203.     essTopBottom: begin
  204.                     DrawVert(Y-AHeight);
  205.                     DrawVert(Y+AHeight);
  206.                   end;
  207.   end;
  208. end;
  209.  
  210. Procedure TCustomErrorSeries.DrawBar(BarIndex,StartPos,EndPos:Longint);
  211. Var tmp         : Longint;
  212.     tmpWidth    : Longint;
  213.     tmpBarWidth : Longint;
  214.     ErrorTop    : Longint;
  215.     tmpError    : Double;
  216. Begin
  217.   if IDrawBar then inherited DrawBar(BarIndex,StartPos,EndPos);
  218.   if FErrorPen.Visible then
  219.   Begin
  220.     tmpError:=FErrorValues.Value[BarIndex];
  221.     if tmpError<>0 then
  222.     Begin
  223.       if IDrawBar and (YValue[BarIndex]<YOrigin) then tmpError:=-tmpError;
  224.       ErrorTop:=CalcYPosValue(YValue[BarIndex]+tmpError);
  225.       tmpBarWidth:=BarBounds.Right-BarBounds.Left;
  226.  
  227.       if FErrorWidth=0 then tmpWidth:=tmpBarWidth
  228.       else
  229.       if FErrorWidthUnits=ewuPercent then
  230.          tmpWidth:=Round(1.0*FErrorWidth*tmpBarWidth/100.0)
  231.       else
  232.          tmpWidth:=FErrorWidth;
  233.  
  234.       if (not IDrawBar) or (YValue[BarIndex]>0) then tmp:=StartPos
  235.                                                 else tmp:=EndPos;
  236.  
  237.       PrepareErrorPen(BarIndex);
  238.       DrawError((BarBounds.Right+BarBounds.Left) div 2,tmp,
  239.                  tmpWidth,tmp-ErrorTop,ParentChart.View3D);
  240.     end;
  241.   end;
  242. End;
  243.  
  244. Procedure TCustomErrorSeries.SetErrorWidthUnits(Value:TErrorWidthUnits);
  245. Begin
  246.   if FErrorWidthUnits<>Value then
  247.   Begin
  248.     FErrorWidthUnits:=Value;
  249.     Repaint;
  250.   end;
  251. end;
  252.  
  253. Procedure TCustomErrorSeries.SetErrorStyle(Value:TErrorSeriesStyle);
  254. begin
  255.   if FErrorStyle<>Value then
  256.   begin
  257.     FErrorStyle:=Value;
  258.     Repaint;
  259.   end;
  260. end;
  261.  
  262. Procedure TCustomErrorSeries.SetErrorValues(Value:TChartValueList);
  263. Begin
  264.   SetChartValueList(FErrorValues,Value); { standard method }
  265. End;
  266.  
  267. Function TCustomErrorSeries.AddErrorBar( Const AX,AY,AError:Double;
  268.                                          Const AXLabel:String;
  269.                                          AColor:TColor):Longint;
  270. Begin
  271.   result:=AddXY(AX,AY,AXLabel,AColor); { standard add X,Y }
  272.   FErrorValues.TempValue:=AError;
  273.   AddValue(result);
  274. End;
  275.  
  276. Procedure TCustomErrorSeries.FillSampleValues(NumValues:Longint);
  277. Var t:Longint;
  278.     tmpX,tmpY,StepX,MinY,DifY:Double;
  279. Begin
  280.   Clear;
  281.   CalcRandomBounds(NumValues,tmpX,StepX,tmpY,MinY,DifY);
  282.   for t:=1 to NumValues do { some sample values to see something in design mode }
  283.   Begin
  284.     AddErrorBar( tmpX,
  285.                  Random(Round(DifY)),
  286.                  DifY/(20+Random(4))
  287.                  {$IFNDEF D4},'', clTeeColor{$ENDIF});
  288.     tmpX:=tmpX+StepX;
  289.   end;
  290.   RefreshSeries;
  291. end;
  292.  
  293. Function TCustomErrorSeries.MaxYValue:Double;
  294. Var t:Longint;
  295. Begin
  296.   result:=inherited MaxYValue;
  297.   for t:=0 to Count-1 do result:=MaxDouble(result,YValue[t]+FErrorValues.Value[t]);
  298. End;
  299.  
  300. Function TCustomErrorSeries.MinYValue:Double;
  301. Var t      : Longint;
  302.     tmp    : Double;
  303.     tmpErr : Double;
  304. Begin
  305.   if IDrawBar then result:=inherited MinYValue else result:=0;
  306.   for t:=0 to Count-1 do
  307.   if IDrawBar then
  308.   Begin
  309.     tmpErr:=FErrorValues.Value[t];
  310.     tmp:=YValue[t];
  311.     if tmp<0 then tmp:=tmp-tmpErr else tmp:=tmp+tmpErr;
  312.     if tmp<result then result:=tmp;
  313.   end
  314.   else
  315.   begin
  316.     tmp:=YValue[t]-FErrorValues.Value[t];
  317.     if t=0 then result:=tmp else result:=MinDouble(result,tmp);
  318.   end;
  319. End;
  320.  
  321. Function TCustomErrorSeries.GetErrorValue(Index:Longint):Double;
  322. Begin
  323.   result:=FErrorValues.Value[Index];
  324. End;
  325.  
  326. Procedure TCustomErrorSeries.SetErrorValue(Index:Longint; Const Value:Double);
  327. Begin
  328.   FErrorValues.Value[Index]:=Value;
  329. End;
  330.  
  331. Function TCustomErrorSeries.GetEditorClass:String;
  332. Begin
  333.   result:='TErrorSeriesEditor';
  334. end;
  335.  
  336. Procedure TCustomErrorSeries.Assign(Source:TPersistent);
  337. begin
  338.   if Source is TCustomErrorSeries then
  339.   With TCustomErrorSeries(Source) do
  340.   begin
  341.     Self.FErrorPen.Assign(FErrorPen);
  342.     Self.FErrorStyle:=FErrorStyle;
  343.     Self.FErrorWidth:=FErrorWidth;
  344.     Self.FErrorWidthUnits:=FErrorWidthUnits;
  345.   end;
  346.   inherited Assign(Source);
  347. end;
  348.  
  349. Procedure TCustomErrorSeries.PrepareForGallery(IsEnabled:Boolean);
  350. Const Colors:Array[Boolean] of TColor=(clSilver,clBlue);
  351.       ErrorColors:Array[Boolean] of TColor=(clWhite,clRed);
  352. begin
  353.   inherited PrepareForGallery(IsEnabled);
  354.   FErrorPen.Color:=ErrorColors[IsEnabled];
  355.   SeriesColor:=Colors[IsEnabled];
  356. end;
  357.  
  358. Procedure TCustomErrorSeries.SetSeriesColor(AColor:TColor);
  359. begin
  360.   inherited SetSeriesColor(AColor);
  361.   if not IDrawBar then FErrorPen.Color:=AColor;
  362. end;
  363.  
  364. Procedure TCustomErrorSeries.DrawLegendShape(ValueIndex:Longint; Const Rect:TRect);
  365. begin
  366.   PrepareErrorPen(ValueIndex);
  367.   With Rect do
  368.     DrawError( (Left+Right) shr 1,(Top+Bottom) shr 1,
  369.                Right-Left,(Bottom-Top) div 2,False);
  370. end;
  371.  
  372. { TErrorBarSeries }
  373. Constructor TErrorBarSeries.Create(AOwner: TComponent);
  374. Begin
  375.   inherited Create(AOwner);
  376.   IDrawBar:=True;
  377.   FErrorStyle:=essTop;
  378. end;
  379.  
  380. Procedure TErrorBarSeries.PrepareForGallery(IsEnabled:Boolean);
  381. begin
  382.   FErrorPen.Width:=2;
  383.   inherited PrepareForGallery(IsEnabled);
  384. end;
  385.  
  386. Procedure TeeErrorSeriesExitProc; far;
  387. begin
  388.   UnRegisterTeeSeries( [TErrorBarSeries,TErrorSeries]);
  389. end;
  390.  
  391. initialization
  392. RegisterTeeSeries(TErrorBarSeries,TeeMsg_GalleryErrorBar,TeeMsg_GalleryExtended,1);
  393. RegisterTeeSeries(TErrorSeries,TeeMsg_GalleryError,TeeMsg_GalleryExtended,1);
  394. {$IFDEF D1}
  395.   AddExitProc(TeeErrorSeriesExitProc);
  396. {$ELSE}
  397. finalization
  398.   TeeErrorSeriesExitProc;
  399. {$ENDIF}
  400. end.
  401.